Code and Notes (Week 9 Thursday)

module PracW9 where

type ID = Int

data Employee = Employee
  { idNumber   :: ID
  , name       :: String
  , supervisor :: Maybe ID
  } deriving (Show,Eq)

type DB = [Employee]

blandingsDB :: DB
blandingsDB =
  --         id name                 supervisor
  [ Employee 1  "The Empress"      $ Nothing,
    Employee 2  "Lord Emsworth"    $ Just 1,
    Employee 3  "Beach the Butler" $ Just 3,
    Employee 4  "Gloria Salt"      $ Just 5
  ]

lookupID :: Int -> DB -> Either String Employee
lookupID n [] = Left "I can't find that user."
lookupID n (e:es)
  | idNumber e == n = Right e
  | otherwise       = lookupID n es

failWith :: Maybe b -> a -> Either a b
failWith res err = maybe (Left err) Right res

supervisorOf :: Int -> DB -> Either String Employee
supervisorOf id db = do
  e <- lookupID id db
  id' <- supervisor e `failWith` "They ain't got one!"
  e' <- lookupID id' db
  return e'
{- alternatively in do notation:

supervisorOf :: Int -> DB -> Maybe Employee
supervisorOf id db =
  do
    e <- lookupID id db
    id' <- supervisor e
    e' <- lookupID id' db
    return e'
 -}




-- boolean parser combinators
-- the code from this point will need to be added to the bottom of your assignment file

{-  you might need some of these imports:

import Data.List(inits,nub,isPrefixOf,elemIndex,findIndex,tails,isSuffixOf)
import Data.Char(isSpace,isDigit,isAlpha,isAlphaNum,isLower)
-}

data Exp = TrueE
         | FalseE
         | VarE String
         | OrE Exp Exp
         | AndE Exp Exp
         | NotE Exp deriving (Eq,Show)

parseTrue :: Parser Exp
parseTrue = do
  keyword "T"
  return TrueE

parseFalse :: Parser Exp
parseFalse = do
  keyword "F"
  return FalseE

assert :: Bool -> Parser ()
assert True = return ()
assert False = abort

parseVar :: Parser Exp
parseVar = do
  v <- parsePred (\c -> isLower c)
  assert (v /= "")
  v' <- parsePred (\c -> isLower c || isDigit c)
  return $ VarE (v ++ v')

-- parseVar :: Parser Exp
-- parseVar = do
--   f <- peekChar
--   assert (isLower f)
--   v <- parsePred (\c -> isLower c || isDigit c)
--   return $ VarE v

parenthesised :: Parser a -> Parser a
parenthesised p = do
  keyword "("
  z <- p
  keyword ")"
  return z

-- parseOr :: Parser Exp
-- parseOr = parenthesised $ do
--   e1 <- parseExp
--   keyword "||"
--   e2 <- parseExp
--   return $ OrE e1 e2

-- parseAnd :: Parser Exp
-- parseAnd = parenthesised $ do
--   e1 <- parseExp
--   keyword "&&"
--   e2 <- parseExp
--   return $ AndE e1 e2

parseOr :: Parser Exp
parseOr = do
  e1 <- parseTerm
  keyword "||"
  e2 <- parseExp
  return $ OrE e1 e2

parseAnd :: Parser Exp
parseAnd = do
  e1 <- parseTerm
  keyword "&&"
  e2 <- parseExp
  return $ AndE e1 e2

parseParen :: Parser Exp
parseParen = do
  keyword "("
  z <- parseExp
  keyword ")"
  return z

parseNot :: Parser Exp
parseNot = do
  keyword "!"
  z <- parseTerm
  return $ NotE z

parseTerm :: Parser Exp
parseTerm = first [ parseNot, parseTrue, parseFalse, parseVar, parseParen ]

parseOp :: Parser Exp
parseOp = first [ parseAnd, parseOr ]

parseExp :: Parser Exp
parseExp = do
  assertNonEmpty
  first [ parseOp, parseTerm ]








assertNonEmpty :: Parser ()
assertNonEmpty =
  Parser(\s ->
             if s == "" then
               Nothing
             else
               Just (s, ()))


{- here is one way I got left-associative parsing working:

mostBeforeList :: String -> String -> [String]
mostBeforeList d s = reverse $ map (\s -> take (length s - 2) s) $ filter (\ss -> isSuffixOf d ss) (inits s)

mostBefore :: String -> Parser a -> Parser a
mostBefore d p = Parser inside
  where
    inside s = thing (mostBeforeList d s)
      where
        thing [] = Nothing
        thing (a:as) = case runParser p a of
          Nothing -> thing as
          Just (x) -> Just(drop (length a) s, x)


parseOr :: Parser Exp
parseOr = do
  e1 <- mostBefore "||" parseExp
  keyword "||"
  e2 <- parseExp
  return $ OrE e1 e2

-}